home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / 2.01 sources / Examples-2.01 / windoid-key-events.lisp < prev   
Encoding:
Text File  |  1993-09-16  |  5.6 KB  |  153 lines  |  [TEXT/CCL2]
  1. ;;-*- Mode: Lisp; Package: CCL -*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; windoid-key-events.lisp
  5. ;; copyright © 1990, Apple Computer, Inc.
  6. ;;
  7. ;;  How to make a windoid handle key events and null events
  8. ;;
  9. ;;
  10. ;; DO-EVENT calls WINDOW-EVENT on the front window for events that
  11. ;; do not include a window as part of their message.
  12. ;; The WINDOW-EVENT method for the WINDOW class then dispatches to:
  13. ;; VIEW-KEY-EVENT-HANDLER, WINDOW-NULL-EVENT-HANDLER, 
  14. ;; WINDOW-KEY-UP-EVENT-HANDLER, or WINDOW-MOUSE-UP-EVENT-HANDLER
  15. ;; If the front window is a WINDOID, the default method for each
  16. ;; of these generic functions, passes the event to the WINDOW-UNDER
  17. ;; the window. If you want to have one of your WINDOIDs handle these events
  18. ;; you need to provide an ACCEPT-KEY-EVENTS method for it and handle
  19. ;; enabling/disabling of the cursor blinker.
  20.  
  21. (in-package :ccl)
  22.  
  23. (eval-when (:execute :compile-toplevel :load-toplevel)
  24.   (export '(click-to-type-windoid x-windoid mouse-window fix-blinkers)))
  25.  
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27. ;;
  28. ;; Change History
  29. ;;
  30. ;; 04/28/93 mwp Release
  31. ;; 04/21/92 bill (provide "WINDOID-KEY-EVENTS")
  32. ;; ------------- 2.0
  33. ;; 11/05/91 bill Don't enable blinkers if a windoid is not active
  34. ;; 01/16/91 bill New file.
  35.  
  36. ; A CLICK-TO-TYPE-WINDOID accepts key events if it was the
  37. ; last window the user clicked in.
  38. (defclass click-to-type-windoid (windoid) ())
  39.  
  40. (defvar *active-window* nil)
  41.  
  42. ; If ACCEPT-KEY-EVENTS returns true, then windoid events are handled
  43. ; locally instead of being passed to the next window.
  44. (defmethod accept-key-events ((w click-to-type-windoid))
  45.   (unless (eq *active-window* *last-mouse-click-window*)
  46.     (fix-blinkers (setq *active-window* *last-mouse-click-window*)))
  47.   (and (eq w *last-mouse-click-window*)
  48.        (current-key-handler w)))
  49.  
  50. ; FIX-BLINKERS is an auxiliary function that we define.
  51. ; It calls TOGGLE-BLINKERS to enable the blinker for the
  52. ; active window and disable the blinkers for other windows.
  53. (defun fix-blinkers (window)
  54.   (flet ((fixit (w)
  55.             (toggle-blinkers w (and (eq w window) (window-active-p w)))))
  56.     (declare (dynamic-extent #'fixit))
  57.     (map-windows #'fixit :include-windoids t)))
  58.  
  59. ; Need to make sure that the blinker is off when a click-to-type-windoid is shown
  60. (defmethod window-show :after ((w click-to-type-windoid))
  61.   (toggle-blinkers w nil))
  62.  
  63. ; And that another window is selected when a click-to-type-windoid is hidden
  64. ; (or closed)
  65. (defmethod window-hide :after ((w click-to-type-windoid))
  66.   (when (eq w *last-mouse-click-window*)
  67.     (fix-blinkers (setq *last-mouse-click-window* (front-window)))))
  68.  
  69. ; Blinkers in subviews normally get turned on.
  70. (defmethod view-activate-event-handler :after ((w click-to-type-windoid))
  71.   (unless (eq w *last-mouse-click-window*)
  72.     (toggle-blinkers w nil)))
  73.  
  74. ; Another auxiliary function to make a windoid with a single fred-dialog-item.
  75. (defun make-example-windoid (&key (class 'click-to-type-windoid)
  76.                                   position size
  77.                                   (window-show t))
  78.   (let ((w (make-instance class :window-show nil)))
  79.     (if position (set-view-position w position))
  80.     (if size (set-view-size w size))
  81.     (make-instance 'fred-dialog-item
  82.                    :view-container w
  83.                    :view-size #@(100 16)
  84.                    :view-position #@(5 5))
  85.     (if window-show (window-show w))
  86.     w))
  87.  
  88. #|
  89. ; Make two example click-to-type-windoids.
  90. ; Play with clicking in them and in this window.
  91. (let* ((w (make-example-windoid))
  92.        (pos (view-position w))
  93.        (size (view-size w)))
  94.   (make-example-windoid :position (add-points pos (make-point (point-h size) 0))))
  95. |#
  96.  
  97. ; An X-WINDOID behaves like a window in the X-WINDOWS system:
  98. ; it is active if the mouse is in it.
  99. (defclass x-windoid (windoid) ())
  100.  
  101. ; Return the window that is under the mouse.
  102. (defun mouse-window ()
  103.   (rlet ((wptr :pointer))
  104.     (#_FindWindow (view-mouse-position nil) wptr)
  105.     (%setf-macptr wptr (%get-ptr wptr))
  106.     (window-object wptr)))
  107.  
  108. ; This variable is bound by the first windoid to call MOUSE-WINDOW, so
  109. ; that MOUSE-WINDOW needs to be called only once per event.
  110. (defvar *mouse-window* nil)
  111.  
  112. (defvar *active-x-windoid* nil)
  113.  
  114. ; WINDOW-EVENT binds *MOUSE-WINDOW* so that it needs to be computed only
  115. ; once per event.
  116. (defmethod window-event :around ((w x-windoid))
  117.   (let* ((*mouse-window* (or (mouse-window) t)))
  118.     (call-next-method)))
  119.  
  120. (defmethod accept-key-events ((w x-windoid))
  121.   (let* ((mouse-window (or *mouse-window* (mouse-window)))
  122.          (new-active (if (typep mouse-window 'x-windoid)
  123.                        (if (eq w mouse-window) w *active-x-windoid*)
  124.                        (front-window))))
  125.     (unless (eq new-active *active-x-windoid*)
  126.       (fix-blinkers (setq *active-x-windoid* new-active)))
  127.     (eq w mouse-window)))
  128.  
  129. (defmethod window-hide :after ((w x-windoid))
  130.   (if (eq w *active-x-windoid*)
  131.     (fix-blinkers (setq *active-x-windoid*
  132.                         (setq *last-mouse-click-window* (front-window))))))
  133.  
  134. ; Blinkers in subviews normally get turned on.
  135. (defmethod view-activate-event-handler :after ((w x-windoid))
  136.   (unless (eq w *active-x-windoid*)
  137.     (toggle-blinkers w nil)))
  138.  
  139. (provide "WINDOID-KEY-EVENTS")
  140.  
  141. #|
  142. ; Make two example X-WINDOIDs.
  143. ; Play with moving the mouse in and out of them.
  144. ; Note that if the mouse is in one of the windoids, it will respond to typing.
  145. (let* ((w (make-example-windoid :class 'x-windoid :window-show nil))
  146.        (size (view-size w))
  147.        (pos (+ (view-position w) (make-point 0 (point-v size)))))
  148.   (set-view-position w pos)
  149.   (window-show w)
  150.   (make-example-windoid 
  151.    :class 'x-windoid
  152.    :position (add-points pos (make-point (point-h size) 0))))
  153. |#